home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagn_r.zip / OOP.SWG / 0012_OOPCOPY.PAS.pas < prev    next >
Pascal/Delphi Source File  |  1993-05-28  |  11KB  |  413 lines
  1. {************************************************}
  2. {                                                }
  3. {   Turbo Pascal 6.0                             }
  4. {   Turbo Vision Utilities                       }
  5. {   Written (w) 1993 by Andres Cvitkovich        }
  6. {                                                }
  7. {   Public Domain                                }
  8. {                                                }
  9. {************************************************}
  10.  
  11. Unit TVUtis;
  12.  
  13. {$F+,O+,S-,D-,B-}
  14.  
  15. Interface
  16.  
  17. Uses Dos, Objects, Views, App;
  18.  
  19. Type
  20.   PProgressBar = ^TProgressBar;
  21.   TProgressBar = Object (TView)
  22.     empty, filled: Char;
  23.     total: LongInt;
  24.     percent: Word;
  25.     Constructor Init (Var Bounds: TRect; ch_empty,
  26.       ch_filled: Char; totalwork: LongInt);
  27.     Procedure Draw; virtual;
  28.     Procedure SetTotal (newtotal: LongInt);
  29.     Procedure Update (nowdone: LongInt); virtual;
  30.     Procedure UpdatePercent (newpercent: Integer); virtual;
  31.   end;
  32.  
  33.   PFileCopy = ^TFileCopy;
  34.   TFileCopy = Object
  35.     bufsize: Word;
  36.     buffer: Pointer;
  37.     ConstRUCTOR Init (BufferSize: Word);
  38.     Destructor Done; VIRTUAL;
  39.     Function  SetBufferSize (newsize: Word): Word; VIRTUAL;
  40.     Function  CopyFile (File1, File2: PathStr): Integer; VIRTUAL;
  41.     Procedure Progress (Bytesdone, Bytestotal: LongInt;
  42.       percent: Integer); VIRTUAL;
  43.     Function  Error (code: Word): Integer; VIRTUAL;
  44.   end;
  45.  
  46. Implementation
  47.  
  48. Uses drivers;
  49.  
  50. Constructor TProgressBar.Init (Var Bounds: TRect; ch_empty, ch_filled: Char;
  51. totalwork: LongInt);
  52. begin
  53.   TView.Init (Bounds);
  54.   total  := totalwork;
  55.   empty  := ch_empty;
  56.   filled := ch_filled;
  57.   percent := 0;
  58. end;
  59.  
  60. Procedure TProgressBar.Draw;
  61. Var
  62.   S: String;
  63.   B: TDrawBuffer;
  64.   C: Byte;
  65.   y: Byte;
  66.   newbar: Word;
  67. begin
  68.   if (Size.X * Size.Y) = 0 then Exit;              { Exit if no extent }
  69.   C := GetColor (6);
  70.   MoveChar (B, empty, C, Size.X);
  71.   MoveChar (B, filled, C, Size.X * percent div 100);
  72.   WriteLine (0, 0, Size.X, Size.Y, B);
  73. end;
  74.  
  75.  
  76. Procedure TProgressBar.SetTotal (newtotal: LongInt);
  77. begin
  78.   total := newtotal
  79. end;
  80.  
  81. Procedure TProgressBar.Update (nowdone: LongInt);
  82. Var newpercent: Word;
  83. begin
  84.   if total=0 then Exit;
  85.   newpercent := 100 * nowdone div total;
  86.   if newpercent > 100 then newpercent := 100;
  87.   if percent <> newpercent then begin
  88.     percent := newpercent;
  89.     DrawView
  90.   end;
  91. end;
  92.  
  93. Procedure TProgressBar.UpdatePercent (newpercent: Integer);
  94. begin
  95.   if newpercent > 100 then newpercent := 100;
  96.   if percent <> newpercent then begin
  97.     percent := newpercent;
  98.     DrawView
  99.   end;
  100. end;
  101.  
  102.  
  103. {
  104.   TFileCopy.Init
  105.   ──────────────
  106.  
  107.   initializes the Object and allocates memory
  108.  
  109.     BufferSize   size of buffer in Bytes to be allocated For disk i/o
  110.  
  111. }
  112. ConstRUCTOR TFileCopy.Init (BufferSize: Word);
  113. begin
  114.   If MaxAvail < BufferSize Then
  115.     bufsize := 0
  116.   Else
  117.     bufsize := BufferSize;
  118.   If bufsize > 0 Then GetMem (buffer, bufsize);
  119. end;
  120.  
  121.  
  122. {
  123.   TFileCopy.Done
  124.   ──────────────
  125.  
  126.   Destructor, free up buffer memory
  127.  
  128. }
  129. Destructor TFileCopy.Done;
  130. begin
  131.   If bufsize > 0 Then FreeMem (buffer, bufsize);
  132.   { bufsize := 0; }   { man weiß ja nie... }
  133. end;
  134.  
  135.  
  136. {
  137.   TFileCopy.SetBufferSize
  138.   ───────────────────────
  139.  
  140.   change buffer size
  141.  
  142.     NewSize = new size of disk i/o buffer in Bytes
  143.  
  144. }
  145. Function TFileCopy.SetBufferSize (newsize: Word): Word;
  146. begin
  147.   If MaxAvail >= newsize Then begin
  148.     If bufsize > 0 Then FreeMem (buffer, bufsize);
  149.     bufsize := newsize;
  150.     If bufsize > 0 Then GetMem (buffer, bufsize);
  151.   end;
  152.   SetBufferSize := bufsize
  153. end;
  154.  
  155.  
  156. {
  157.   TFileCopy.CopyFile
  158.   ──────────────────
  159.  
  160.   copy a File onto another; no wildcards allowed
  161.   calls Progress and Error
  162.  
  163.     File1   source File
  164.     File2   target File
  165.  
  166.   Error code returned:
  167.  
  168.    1  low on buffer memory
  169.    2  error opening source File
  170.    3  error creating destination File
  171.    4  error reading from source File
  172.    5  error writing to destination File
  173.    6  error writing File date/time and/or attributes
  174.  
  175. }
  176. Function TFileCopy.CopyFile (File1, File2: PathStr): Integer;
  177. Var fsrc, fdest: File;
  178.     fsize, ftime, cnt, cnt1: LongInt;
  179.     fattr, rd, wr, iores: Word;
  180. begin
  181.   {$I-}
  182.   If bufsize = 0 then begin CopyFile := 1; Exit end;
  183.   Assign (fsrc, File1);
  184.   Repeat
  185.     Reset (fsrc, 1);
  186.     iores := IOResult;
  187.     If iores <> 0 Then
  188.       If Error (iores) = 1 Then begin
  189.         CopyFile := 2;
  190.         Exit
  191.       end;
  192.   Until iores = 0;
  193.   Assign (fdest, File2);
  194.   Repeat
  195.     ReWrite (fdest, 1);
  196.     iores := IOResult;
  197.     If iores <> 0 Then
  198.       If Error (iores) = 1 Then begin
  199.         Close (fsrc);
  200.         CopyFile := 3;
  201.         Exit
  202.       end;
  203.   Until iores = 0;
  204.   fsize := FileSize (fsrc);
  205.   GetFTime (fsrc, ftime);
  206.   GetFAttr (fsrc, fattr);
  207.   Repeat
  208.     Repeat
  209.       cnt := FilePos (fsrc);
  210.       BlockRead (fsrc, buffer^, bufsize, rd);
  211.       iores := IOResult;
  212.       If iores <> 0 Then begin
  213.         If Error (iores) = 1 Then begin      {abort?}
  214.           Close (fsrc);                      {* }
  215.           Close (fdest);                     {* hier könnte man auch}
  216.           Erase (fdest);                     {* Error aufrufen, naja...}
  217.           CopyFile := 4;
  218.           Exit;
  219.         end;
  220.         Seek (fsrc, cnt);      {step back on retry!}
  221.       end;
  222.     Until iores = 0;
  223.     if rd > 0 then
  224.       Repeat
  225.         cnt1 := FilePos (fdest);
  226.         BlockWrite (fdest, buffer^, rd, wr);
  227.         iores := IOResult;
  228.         If (rd <> wr) or (iores <> 0) Then begin
  229.           If Error (iores) = 1 Then begin      {abort?}
  230.             Close (fsrc);                      {* }
  231.             Close (fdest);                     {* hier könnte man auch}
  232.             Erase (fdest);                     {* Error aufrufen, naja...}
  233.             CopyFile := 5;
  234.             Exit;
  235.           end;
  236.           Seek (fdest, cnt1);      {step back on retry!}
  237.         end;
  238.       Until (rd = wr) and (iores = 0);
  239.     Progress (cnt, fsize, cnt * 100 div fsize);
  240.   Until (rd = 0) or (rd <> wr);
  241.   Close (fsrc);
  242.   Repeat
  243.     Close (fdest);     {close&flush}
  244.     iores := IOResult;
  245.     If iores <> 0 Then If Error (iores) = 1 Then Exit;
  246.   Until iores = 0;
  247.   Reset (fdest);
  248.   If IOResult <> 0 Then begin CopyFile := 6; Exit end;
  249.   SetFTime (fdest, ftime);
  250.   SetFAttr (fdest, fattr);
  251.   If IOResult <> 0 Then begin Close (fdest); CopyFile := 6; Exit end;
  252.   Close (fdest);
  253. end;
  254.  
  255.  
  256. {
  257.   TFileCopy.Progress
  258.   ──────────────────
  259.  
  260.   is called by CopyFile to allow displaying a progress bar or s.e.
  261.  
  262.     Bytesdone    Bytes read in and written
  263.     Bytestotal   Bytes to read&Write total (that is, File size)
  264.     percent      amount done in percent
  265.  
  266. }
  267. Procedure TFileCopy.Progress (Bytesdone, Bytestotal: LongInt; percent:
  268. Integer);
  269. begin
  270.   {abstract - inherit For use!}
  271. end;
  272.  
  273. {
  274.   TFileCopy.Error
  275.   ───────────────
  276.  
  277.   is called by CopyFile if an error occured during the copy process
  278.  
  279.     code   the IOResult code <> 0
  280.  
  281.   should return an Integer value:
  282.  
  283.     0  Repeat action
  284.     1  abort
  285.  
  286.   Note: TurboVision installs it's own Dos critical error handler, so you
  287.         don't need to overWrite Error (only called if Abort is chosen from
  288.         the TV Error Msg) if you use CopyFile in a TV Program.
  289.  
  290. }
  291. Function TFileCopy.Error (code: Word): Integer;
  292. begin
  293.   Error := 1;
  294. end;
  295.  
  296.  
  297. end.
  298.  
  299.  
  300. {
  301. > Unit TVUtis;
  302. >
  303. >   Wow...never seen so much code just to copy a File! =)
  304.  
  305. well, it's a quite extendable Object, and there's a lot of error-checking,
  306. too.  just see below... :-)
  307.  
  308. >   I haven't tried OOP yet, and probably was lucky to
  309.  
  310. >      Anyways, I see you left out a progress display in
  311. >   TFileCopy.Progress, but the Unit also has an a progress bar
  312. >   Object.  Any way to marry the two?
  313.  
  314. of course, that's why I put them together!
  315. but I didn't want to have the progress bar (and along With this Turbo Vision)
  316. being an essential part of the FileCopy Object, since some guys might want to
  317. Write their own ProgressBars or use the whole Object in a non-TV Program.
  318.  
  319. >    I implemented your TCopyFile like so...
  320. >
  321. >     Uses Dos, TVUtis;
  322. >     Var
  323. >       DoCopy: TFileCopy;
  324. >       F1, F2: PathStr;
  325. >       R: Integer;
  326. >     begin
  327. >       F1 := 'C:\tp\copyf.pas';
  328. >       F2 := 'C:\copyf.pas';
  329. >       DoCopy.Init(4096);
  330. >       R := DoCopy.CopyFile(F1, F2);
  331. >       DoCopy.Done;
  332. >       Writeln(R);
  333. >     end.
  334.  
  335. Absolutely correct, no doubt. But poor Graphics...  ;-)
  336.  
  337. >      How would one modify that and TFileCopy.Progress to use
  338. >     TProgressBar? From what I can surmise, you'd init
  339. >      TProgressBar and then TFilecopy.Progress would
  340. >       call it somehow, like TProgressBar.Update?
  341. >       I don't see what I should put For the totalwork of
  342. >       TProgressBar.Init; the size of the File? Then that
  343. >       means I must cal TProgress.Init from inside
  344. >       TFileCopy.CopyFile (after we have the size of the
  345. >       File.) And TFileCopy.Progress would call
  346. >        TProgressBar.Update.
  347.  
  348. first of all: The TProgressBar Object is written For Turbo Vision, you can't
  349. use it within a non-TV Program. Next, you have to derive your own Object from
  350. TFileCopy and overWrite the method Progress that calls TProgressBar. Take the
  351. following as an example:
  352. }
  353.  
  354. Type
  355.   PXFileCopy = ^TXFileCopy;
  356.   TXFileCopy = Object (TFileCopy)
  357.     AProgressBar: PProgressBar;
  358.     ConstRUCTOR Init (BufferSize: Word; ProgBar: PProgressBar);
  359.     Procedure Progress (Bytesdone, Bytestotal: LongInt;
  360.                         percent: Integer); VIRTUAL;
  361.   end;
  362.  
  363. ConstRUCTOR TXFileCopy.Init (BufferSize: Word; ProgBar: PProgressBar);
  364. begin
  365.   inherited Init (BufferSize);     { or TFileCopy.Init For TP 6 }
  366.   AProgressBar := ProgBar;
  367. end;
  368.  
  369. Procedure TXFileCopy.Progress (Bytesdone, Bytestotal: LongInt;
  370.                                percent: Integer);
  371. begin
  372.   if AProgressBar <> NIL then
  373.     AProgressBar^.UpdatePercent (percent);
  374. end;
  375. {
  376. You then would use this Object (in a Turbo Vision Program) as follows:
  377. }
  378.  
  379. Function TMyApp.CopyFile (source, dest: PathStr): Integer;
  380. Var
  381.   Dlg: TDialog;
  382.   MyBar: PProgressBar;
  383.   R: TRect;
  384.   DoCopy: TXFileCopy;
  385. begin
  386.   R.Assign (0,0,40,8);
  387.   Dlg.Init (R, 'Copying File...');
  388.   Dlg.Options := Dlg.Options or ofCentered;
  389.   Dlg.Flags := Dlg.Flags and not wfClose;
  390.   R.Assign (2,2,38,4);
  391.   Dlg.Insert (New (PStaticText, Init (R, ^C'copying '+source+#13+
  392.                                       ^C'to '+dest+', please wait...')));
  393.   R.Assign (2,5,38,6);
  394.   Dlg.Insert (New (PStaticText, Init (R,
  395.                    '0%              50%             100%')));
  396.   R.Move (0, 1);
  397.   MyBar := New (PProgressBar, Init (R, '░', '▓', 0));
  398.   Dlg.Insert (MyBar);
  399.   Desktop^.Insert (@Dlg);
  400.   DoCopy.Init (4096, MyBar);
  401.   ErrorCode := DoCopy.CopyFile (source, dest);
  402.   DoCopy.Done;
  403.   Dlg.Done;
  404.   if ErrorCode <> 0 then
  405.     MessageBox ('Error copying File!', NIL, mfError+mfOkButton);
  406. end;
  407.  
  408. {
  409. If you don't want to have any progress bar at all, just pass NIL instead of
  410. MyBar to DoCopy.Init. And maybe you want to add this Functionality directly to
  411. TFileCopy rather than deriving a new Object.
  412. }
  413.